unit AsyncFileWriters;

(**************************************************************************************************)
(* Ejemplo de escritura en segundo plano con thread de baja prioridad                             *)
(* Escrito por Diego Finochietto. 11/06/2005                                                      *)
(**************************************************************************************************)

interface

uses
  SysUtils, Classes, SyncObjs;

type
  TAsyncTextFileWriter = class
  private
    FFileName : string;
    FOpened : boolean;
    FWriteThread : TThread;
    FPriority: TThreadPriority;
    procedure SetFileName(const Value: string);
  public
    constructor Create( const aFileName: string='' );//si afilename es <>'' abre el archivo
    destructor Destroy; override;
    procedure Open;
    procedure Close;
    procedure Write( const aline: string );
    procedure WriteLn( const aline: string );
    property FileName: string read FFileName write SetFileName;
    property Opened: boolean read FOpened;
    property Priority: TThreadPriority read FPriority write FPriority;
  end;

implementation

type
  TBufferOp = (boNop, boWrite, boWriteLn, boEOF);
  TWriteThread = class(TThread)
  private
    FOwner : TAsyncTextFileWriter;
    FBuffer : TStringList;
    FLock : TCriticalSection;
    FBufferNotEmpty : TSimpleEvent;
    procedure AddToBuffer(op: TBufferOp; const aline: string);
  protected
    function ExtractFromBuffer( var aline: string; var op: TBufferOp ): boolean;
    procedure Execute; override;
  public
    constructor Create( aOwner: TAsyncTextFileWriter );
    destructor Destroy; override;
    procedure Add(const aline: string);
    procedure AddLn(const aline: string);
    procedure AddEOF;
  end;

resourcestring
  rsArchivoAbierto='El archivo ya esta abierto';
  rsArchivoNoAbierto='El archivo no esta abierto';

{ TWriteThread }

constructor TWriteThread.Create(aOwner: TAsyncTextFileWriter);
begin
  FOwner := aOwner;
  inherited Create(true);
  FLock := TCriticalSection.Create;
  FBuffer := TStringList.Create;
  FBufferNotEmpty := TSimpleEvent.Create;
  Priority := FOwner.Priority;
  Resume;
end;

procedure TWriteThread.AddToBuffer(op: TBufferOp; const aline: string);
begin
  FLock.Enter;
  try
    FBuffer.AddObject(aline,pointer(op));
    FBufferNotEmpty.SetEvent;
  finally
    FLock.Leave;
  end;
end;

procedure TWriteThread.Add(const aline: string);
begin
  AddToBuffer(boWrite,aline);
end;

procedure TWriteThread.AddLn(const aline: string);
begin
  AddToBuffer(boWriteLn,aline);
end;

procedure TWriteThread.AddEOF;
begin
  AddToBuffer(boEOF,'');
end;

function TWriteThread.ExtractFromBuffer( var aline: string; var op: TBufferOp ): boolean;
var
  l : string;
begin
  FLock.Enter;
  try
    if FBuffer.Count>0 then begin
      l := FBuffer[0];
      op := TBufferOp(FBuffer.Objects[0]);
      aline := l;
      FBuffer.Delete(0);
      result := true;
    end else begin
      result := false;
      op := boNop;
      FBufferNotEmpty.ResetEvent;
    end;
  finally
    FLock.Leave;
  end;
end;

procedure TWriteThread.Execute;
var
  t : TextFile;
  op : TBufferOp;

  procedure WriteAllBuffer;
  var
    l : string;
  begin
    while ExtractFromBuffer(l,op) and (op<>boEOF) do
      case op of
        boWrite:   Write(t,l);
        boWriteLn: Writeln(t,l);
      end;
  end;

begin
  AssignFile(t,FOwner.FFileName);
  if FileExists(FOwner.FFileName) then Append(t)
  else Rewrite(t);
  while not Terminated do begin
    FBufferNotEmpty.WaitFor(5000);
    WriteAllBuffer;
    if(op=boEOF)then break;
  end;
  CloseFile(t);
end;

destructor TWriteThread.Destroy;
begin
  FBufferNotEmpty.Free;
  FBuffer.Free;
  FLock.Free;
  inherited;
end;

{ TAsyncTextFileWriter }

constructor TAsyncTextFileWriter.Create(const aFileName: string);
begin
  inherited Create;
  FFileName := aFileName;
  FPriority := tpLowest;
  if not(FFileName='')then Open;
end;

destructor TAsyncTextFileWriter.Destroy;
begin
  if Opened then Close;
  inherited;
end;

procedure TAsyncTextFileWriter.SetFileName(const Value: string);
begin
  if Opened then raise Exception.Create(rsArchivoAbierto);
  FFileName := Value;
end;

procedure TAsyncTextFileWriter.Open;
begin
  if Opened then raise Exception.Create(rsArchivoAbierto);
  FWriteThread := TWriteThread.Create(Self);
  FOpened := true;
end;

procedure TAsyncTextFileWriter.Close;
begin
  if not Opened then raise Exception.Create(rsArchivoNoAbierto);
  TWriteThread(FWriteThread).AddEOF;
  FWriteThread.WaitFor;
  FreeAndNil(FWriteThread);
  FOpened := false;
end;

procedure TAsyncTextFileWriter.WriteLn(const aline: string);
begin
  if not Opened then raise Exception.Create(rsArchivoNoAbierto);
  TWriteThread(FWriteThread).AddLn(aline);
end;

procedure TAsyncTextFileWriter.Write(const aline: string);
begin
  if not Opened then raise Exception.Create(rsArchivoNoAbierto);
  TWriteThread(FWriteThread).Add(aline);
end;

end.
